perm filename XGPSYN.SAI[PIX,HPM]10 blob
sn#301192 filedate 1977-08-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "XGPSYN"
C00011 00003 DBUG←FALSE
C00013 00004 DO
C00016 00005 FPN←IF XGP THEN 2 ELSE 1 FPNR←0 S←"" PN←2
C00019 00006 DO
C00028 00007 IF PAGE ∧ PN>0 THEN
C00031 00008 comment assemble line of text
C00032 00009 comment calculate height of line
C00038 00010 comment assemble line
C00051 00011 comment dislpay page
C00054 ENDMK
C⊗;
BEGIN "XGPSYN"
REQUIRE "FNTHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "SYNSUB.REL[PIX,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE HELPER;
EXTERNAL PROCEDURE NOCHAN;
EXTERNAL PROCEDURE FEWCHN(INTEGER N);
EXTERNAL PROCEDURE FIRST;
EXTERNAL PROCEDURE FIRST1;
EXTERNAL PROCEDURE FIRST2;
EXTERNAL PROCEDURE FIRST3;
EXTERNAL PROCEDURE CRLF;
EXTERNAL PROCEDURE FILNM;
EXTERNAL PROCEDURE FONTNO(INTEGER N);
BOOLEAN PRNT,XGP,DBUG,SPOOLFLAG,WHITELET;
INTEGER ARRAY FHD[0:'17,0:'203];
INTEGER FNTN,SFNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,QUAD,LUND;
INTEGER NCHN,I,J,K,NUMCH,TXTPNT;
INTEGER PN1,PN2,PN3;
INTEGER ARRAY PNS[0:300];
REAL FPN,FPNR;
STRING INSTR,INFILE,S,SWT,SPOOLF;
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
WHILE LENGTH(INSTR)=0 ∧ ¬EOF DO INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; RETURN(LOP(INSTR));
END;
SIMPLE PROCEDURE MXCH(INTEGER M);
BEGIN
INTEGER I;
IF PRNT THEN FOR I←1 STEP 1 UNTIL M DO IDPB(NXCH,TXTPNT)
ELSE FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE PROCEDURE SMXCH(INTEGER M);
BEGIN
INTEGER I;
FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE INTEGER PROCEDURE PNXCH(INTEGER I);
BEGIN
INTEGER J;
J←I;
WHILE (J←J-1)≥0 ∧ LENGTH(INSTR)<I ∧ ¬EOF DO
INSTR←INSTR&INPUT(CHAN,1) ;
RETURN(INSTR[I TO I]);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 5],"FONT#") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNO←INTSCAN(FNTNMS,FOO);
FNTNMS←FNTNMS[2 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FONTNO(FTNO); PRINT(FTNM," ");
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
FONTNO(FTNO); PRINT(FTNM);
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"FONT=") THEN
BEGIN
STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
PRINT("FONT#1=",FTNM," ");
WHILE FNTSEL(1,FTNM,FHD[1,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
PRINT("FONT#1=",FTNM," ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"TMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
TMAR←INTSCAN(FNTNMS,FOO);
PRINT("TMAR=",TMAR," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"PMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
PMAR←INTSCAN(FNTNMS,FOO);
PRINT("PMAR=",PMAR," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"BMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
BMAR←INTSCAN(FNTNMS,FOO);
PRINT("BMAR=",BMAR," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"LMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
LMAR←INTSCAN(FNTNMS,FOO);
PRINT("LMAR=",LMAR," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"RMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
RMAR←INTSCAN(FNTNMS,FOO);
PRINT("RMAR=",RMAR," ");
END
ELSE IF EQU(FNTNMS[1 TO 6],"XLINE=") THEN
BEGIN
FNTNMS←FNTNMS[7 TO ∞];
XLINE←INTSCAN(FNTNMS,FOO);
PRINT("XLINE=",XLINE," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"XOFF=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
XOFF←INTSCAN(FNTNMS,FOO);
PRINT("XOFF=",XOFF," ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"YOFF=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
YOFF←INTSCAN(FNTNMS,FOO);
PRINT("YOFF=",YOFF," ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"XGP") THEN
BEGIN
FNTNMS←FNTNMS[4 TO ∞];
XGP←TRUE;
PRINT("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 4],"-XGP") THEN
BEGIN
FNTNMS←FNTNMS[5 TO ∞];
XGP←FALSE;
PRINT("-XGP ");
END;
END;
END;
PROCEDURE SETOFFSET;
IF QUAD="T" THEN
BEGIN
YOFF←-36; XOFF←0;
END
ELSE IF QUAD="B" THEN
BEGIN
YOFF←0; XOFF←-36;
END
ELSE IF QUAD="E" THEN
BEGIN
YOFF←TMAR; XOFF←LMAR;
END
ELSE IF QUAD="H" THEN
BEGIN
YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30)-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END
ELSE IF QUAD="F" THEN
BEGIN
YOFF←TMAR-((512*4-PMAR)%2 MAX 0)+FPNR*512*4;
XOFF←((LMAR-20) MIN (RMAR-3*480)) MAX -10;
END
ELSE IF QUAD="D" THEN
BEGIN
YOFF←TMAR+FPNR*481*4-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END;
STRING PROCEDURE GETINCHWL;
BEGIN
PRELOAD_WITH 10000;
OWN INTEGER ARRAY PAGEND[1:1];
PRELOAD_WITH 0;
OWN INTEGER ARRAY INDEX[1:1];
IF INDEX[1]=0∧(EOF ∨ PN>PAGEND[1]) THEN SPOOLFLAG←FALSE;
IF SPOOLFLAG THEN
BEGIN
INDEX[1]←(INDEX[1]+1) MOD 2;
RETURN(IF INDEX[1]=1 THEN "" ELSE "X");
END
ELSE RETURN(INCHWL);
END;
DBUG←FALSE;
CRLF; PRINT("Type ?<cr> for help"); CRLF; CRLF;
NCHN←0; FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN NOCHAN ELSE IF NCHN<3 THEN FEWCHN(NCHN);
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I");
BREAKSET(1,"","O"); BREAKSET(1,"","Z");
DDINIT;
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
XLINE←4;
SPOOLFLAG←FALSE;
WHITELET←FALSE;
BEGIN "FILE"
DEFINE FSIZE=5000;
INTEGER FOO,HIG,POS,I,J; INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS; BOOLEAN PAGE;
FCACHE(FONT[0],FSIZE);
FNTSEL(1,"GACB25.FNT[XGP,SYS]",FHD[1,0]); comment select the default font;
DO
BEGIN
STRING SF;
CHAN←GETCHAN;
FILNM; FIRST3; PRINT(":");
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN HELPER ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
NUMCH←0;
IF LENGTH(S)>0 THEN SWITCHES(S); comment parse any spooler style switches;
IF XGP THEN SPOOLF←"XS "&DEVPRS&":"&FILPRS&"/NOTITLE/NOHEAD"&'15&'12;
LASTFF←0; PNS[LASTFF]←(1 LSH 27) LOR 0;
IF XGP THEN
BEGIN
SWT←"";
WHILE PNXCH(1)≠'14 DO
BEGIN
INTEGER NX;
NX←NXCH;
IF NX≠'15∧NX≠'12∧NX≠" " THEN SWT←SWT&NX;
END;
NXCH;
SWITCHES(SWT);
IF LMAR=0 THEN LMAR←150; comment LMAR=0, barfbag PUB default;
LASTFF←1;
PNS[LASTFF]←(1 LSH 27) LOR NUMCH;
END;
FNTN←PNS[LASTFF] LSH -27; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
CRLF;
FPN←IF XGP THEN 2 ELSE 1; FPNR←0; S←""; PN←2;
PRINT("Full density"); CRLF; QUAD←"F";
WHILE TRUE DO
BEGIN "DENSITY"
XCMP←IF QUAD="B"∨QUAD="T"∨QUAD="E" THEN 1 ELSE IF QUAD="D" THEN 6 ELSE 3;
YCMP←IF QUAD="B"∨QUAD="T"∨QUAD="E" THEN 1 ELSE IF QUAD="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF QUAD="B" THEN TMAR+PMAR+BMAR ELSE
IF QUAD="T" THEN RMAR
ELSE 481,
WI←IF QUAD="B" THEN 1700+37 ELSE
IF QUAD="T" THEN
(TMAR+PMAR+BMAR+37) MIN 1700
ELSE 512,
BI←IF QUAD="H" THEN 3
ELSE IF QUAD="F" THEN 4
ELSE IF QUAD="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
BEGIN
IF NCHN=0 THEN PRINT("No synthesizer channels.") ELSE
PRINT(PIC[BYBI]-NCHN," synthesizer channels too few.");
CRLF;
END;
DO
BEGIN "PAGES"
INTEGER FOO;
IF ¬SPOOLFLAG THEN
IF QUAD="D" THEN
BEGIN PRINT("FIRST PAGE #"); FIRST; PRINT(":"); END
ELSE IF QUAD="F" ∨ QUAD="B" ∨ QUAD="E" THEN
BEGIN PRINT("PAGE #"); FIRST; PRINT(":"); END
ELSE
BEGIN PRINT("PAGE"); FIRST1; FIRST; PRINT(":"); END;
TTYUP(TRUE); S←GETINCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
PAGE←TRUE;
END
ELSE IF (S LAND '137)="L" THEN
BEGIN
PRINT("listing ..."); CRLF;
QUAD←"B";
SPOOLFLAG←TRUE;
PN←-1;
PAGE←FALSE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF QUAD="E" THEN
BEGIN
OUTSTR("White on black?");
SCREEN(0,0,1,1); DDINIT; LITEN;
IF (INCHWL LAND '137)="Y" THEN RECTAN(0,0,1,1);
VIDONE(PIC[0],1);
OUTSTR("SIZE(-5 to 5):");
XGPUP(CVD(INCHWL));
END
ELSE
IF QUAD="B" THEN VIDXGP(PIC[0],YOFF,XOFF,TMAR+PMAR+BMAR) ELSE
IF QUAD="T" THEN VIDXGP(PIC[0],0,YOFF,RMAR)
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T" THEN 0 ELSE DDSIZ];
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE
BEGIN PRINT(" DONE"); CRLF; END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
PRINT("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
MAPGRY(-1,0);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="Q" THEN
BEGIN
LODED(SPOOLF);
CALL(0,"EXIT");
PAGE←FALSE;
END
ELSE IF (S LAND '137)="W" THEN
BEGIN
WHITELET←¬WHITELET;
IF WHITELET THEN PRINT("White letters on black")
ELSE PRINT("Black letters on white");
CRLF;
BEGIN
INTEGER I,J,K;
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
HELPER;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" ∨ (S LAND '137)="E" THEN
BEGIN
S←S LAND '137;
PRINT(IF S="B" THEN "bitwise" ELSE
IF S="E" THEN "enormous" ELSE
IF S="T" THEN "bitwise transposed" ELSE
IF S="F" THEN "full" ELSE IF S="H" THEN "half" ELSE "double");
PRINT(" density"); CRLF;
QUAD←S;
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO); IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN BEGIN PN←FPN; SETOFFSET; END;
IF PAGE ∧ PN=1 ∧ XGP THEN
BEGIN
PRINT("Page 1 defines fonts, substance begins on page 2"); CRLF;
PAGE←FALSE;
END
ELSE
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
INTEGER PNSLASTFF;
LASTFF←PN-1;
WHILE LASTFF>0 ∧ PNS[LASTFF]=0 DO LASTFF←LASTFF-1;
PNSLASTFF←PNS[LASTFF] LAND '777777777;
EOF←FALSE;
USETI(CHAN,1+PNSLASTFF%('200*5));
INSTR←""; NUMCH←(PNSLASTFF%('200*5))*'200*5;
FOR I←(PNSLASTFF MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
FNTN←PNS[LASTFF] LSH -27;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
END;
WIPE(PIC[0],0);
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0;
WHILE ¬EOF ∧ LASTFF<(IF QUAD="D" THEN PN+1 ELSE PN) DO
BEGIN
INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF QUAD="D" ∧ LASTFF=PN THEN
XOFF←(((LMAR-20) MIN (RMAR-3*512))MAX -10)-512*3;
IF QUAD="D" ∧ LASTFF≠PN THEN
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
comment calculate height of line;
SBASE←BASE; SFNTN←FNTN; XPOS←LMAR;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE;
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
PN1←PNXCH(1); PN2←PNXCH(2); PN3←PNXCH(3);
IF PN1=0 THEN SMXCH(1)
ELSE IF PN1='177 THEN
IF PN2='1 THEN
IF PN3≤'17 THEN
BEGIN
FNTN←PN3;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
MXCH(3);
END
ELSE IF PN3='43 THEN
BEGIN
BASE←((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='52 THEN
BEGIN
BASE←BASE+((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='40 THEN
BEGIN
XPOS←PNXCH(4)*128+PNXCH(5);
MXCH(5);
END
ELSE IF PN3='41 THEN
BEGIN
YU←YU MAX ((PNXCH(4) LSH 29) ASH -29);
YL←YL MIN ((PNXCH(4) LSH 29) ASH -29);
XPOS←XPOS+PNXCH(5)*128+PNXCH(6);
MXCH(6);
END
ELSE IF PN3='42 THEN
BEGIN
MXCH(4);
DUN←TRUE;
END
ELSE IF PN3='44 THEN MXCH(3)
ELSE IF PN3='45 THEN MXCH(4+PNXCH(4))
ELSE IF PN3='46 THEN MXCH(3)
ELSE IF PN3='47 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(4) LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
MXCH(4);
END
ELSE IF PN3='50 THEN MXCH(4)
ELSE IF PN3='51 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(5) LSH 29) ASH -29);
YU←YU MAX (YP+PNXCH(4)); YL←YL MIN YP;
MXCH(5);
END
ELSE MXCH(3)
ELSE IF PN2=2 THEN
BEGIN
XPOS←XPOS+((PN3 LSH 29) ASH -29);
MXCH(3);
END
ELSE IF PN2=3 THEN
BEGIN
YPOS←PN3*128+PNXCH(4);
MXCH(4);
END
ELSE IF PN2=4 THEN MXCH(13)
ELSE IF PN2='11
∨ PN2='12
∨ PN2='14
∨ PN2='15
∨ (PN2≥'16 ∧PN2≤'177) THEN
IF XPOS≤RMAR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN2] LSH -18);
MXCH(2);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE
ELSE MXCH(2)
ELSE IF PN1='15 THEN BEGIN XPOS←LMAR; MXCH(1); END
ELSE IF PN1='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN," "] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
MXCH(1);
END
ELSE
IF XPOS≤RMAR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN1] LSH -18);
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
PNS[LASTFF]←(FNTN LSH 27) LOR (NUMCH+1);
PRINT(LASTFF," ");
END;
DUN←TRUE;
END;
MXCH(1);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE;
END "HEIGHT";
BASE←SBASE;
FNTN←SFNTN; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
XPOS←LMAR;
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
IF LDB(TXTPNT)='177 THEN
IF ILDB(TXTPNT)='1 THEN
IF ILDB(TXTPNT)≤'17 THEN
BEGIN
FNTN←LDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END
ELSE IF LDB(TXTPNT)='43 THEN
BASE←((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='52 THEN
BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='40 THEN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='41 THEN
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR XP←XPOS STEP 1 UNTIL XNEW DO
CASE QUAD OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"] PUTEL(PIC[0],YP,XP-XOFF,1);
["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-XP-XOFF,YP,1)
END;
XPOS←XNEW;
END
ELSE IF LDB(TXTPNT)='42 THEN YPOS←YPOS+YU+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='45 THEN
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END
ELSE IF LDB(TXTPNT)='46 THEN LUND←XPOS
ELSE IF LDB(TXTPNT)='47 THEN
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
FOR XP←LUND STEP 1 UNTIL XPOS DO
CASE QUAD OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"] PUTEL(PIC[0],YP,XP-XOFF,1);
["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-XP-XOFF,YP,1)
END;
END
ELSE IF LDB(TXTPNT)='50 THEN IBP(TXTPNT)
ELSE IF LDB(TXTPNT)='51 THEN
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
CASE QUAD OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP+TH-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP+TH-XOFF)%XCMP,1);
["B"] PUTEL(PIC[0],YP,XP+TH-XOFF,1);
["E"] PUTEL(PIC[0],YP,XP+TH-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP+TH-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-XP+TH-XOFF,YP,1)
END;
END
ELSE
ELSE IF LDB(TXTPNT)=2 THEN
XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)=3 THEN
YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL
ELSE IF LDB(TXTPNT)=4 THEN
BEGIN
INTEGER J,K,X0,Y0,N,W,DX;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
X0←(X0 ASH 9) + (DX ASH -1);
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
FOR K←W-1 STEP -1 UNTIL 0 DO
CASE QUAD OF
BEGIN
["H"] ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+(X0 ASH -9)-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+(X0 ASH -9)-XOFF)%XCMP,1);
["B"] PUTEL(PIC[0],J+Y0-YOFF,
K+(X0 ASH -9)-XOFF,1);
["E"] PUTEL(PIC[0],J+Y0-YOFF,
K+(X0 ASH -9)-XOFF,1);
["F"] ADDEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1);
["T"] PUTEL(PIC[0],
PIC[PCLN]-K+(X0 ASH -9)-XOFF,
J+Y0-YOFF,1)
END;
X0←X0+DX;
END;
END
ELSE IF LDB(TXTPNT)='11 ∨
LDB(TXTPNT)='12 ∨
LDB(TXTPNT)='14 ∨
LDB(TXTPNT)='15 ∨
(LDB(TXTPNT)≥'16 ∧ LDB(TXTPNT)≤'177) THEN
BEGIN
CASE QUAD OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE
ELSE IF LDB(TXTPNT)='12 THEN YPOS←YPOS+YU+XLINE
ELSE IF LDB(TXTPNT)='15 THEN XPOS←LMAR
ELSE IF LDB(TXTPNT)='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN," "] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
END
ELSE IF LDB(TXTPNT)='14 THEN
BEGIN
XPOS←LMAR;
YPOS←TMAR;
END
ELSE IF LDB(TXTPNT)≠0 THEN
BEGIN
CASE QUAD OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE ;
END"ASSLP";
END "ASSEMBLE";
END;
comment dislpay page;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]); GRAY(PIC[0]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T"∨QUAD="E"
THEN 0 ELSE DDSIZ];
IF WHITELET THEN
BEGIN
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
DDINIT;
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE
BEGIN PRINT(" DONE"); FIRST2; CRLF; END;
IF QUAD="H"∨QUAD="T" THEN FPN←FPN+.5 ELSE
IF QUAD="F"∨QUAD="B" THEN FPN←(PN←FPN)+1 ELSE
IF QUAD="E" THEN FPN←FPN+1/4.5 ELSE
IF QUAD="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END "XGPSYN";